近年來由於Node.js的崛起，JavaScript語言成為了顯學，再加上NoSQL的資料庫崛起，一同了帶動JSON資料格式的應用，回到主題，古老的MS Access要怎麼處理這類型的資料？筆者找了一下網路現有的解決方案，似乎都是使用Microsoft Script Control來處理資料，而Github上有個較多人的項目：

(https://github.com/VBA-tools/VBA-JSON)[https://github.com/VBA-tools/VBA-JSON]

目前是不支援MS Access 2003的，後來找到Dymeng公司提供的程式碼，支援了2003的版本：
(https://dymeng.com/parsing-json-with-vba/)[https://dymeng.com/parsing-json-with-vba/]

程式碼如下：

JsonParser模組

Option Compare Database
Option Explicit
'來源：https://dymeng.com/parsing-json-with-vba/
'http://stackoverflow.com/questions/6627652/parsing-json-in-excel-vba
'HOW TO PARSE JSON WITH VBA (MS ACCESS/EXCEL)
'by Jack D. Leach | Jun 11, 2017

Public Enum JsonPropertyType
    jptObject
    jptValue
End Enum
 
Private ScriptEngine As Object 'ScriptControl (ref: Microsoft Script Control 1.0)
 
Public Sub InitScriptEngine()
    Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl") 'New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub
 
Public Function DecodeJsonString(ByVal JSonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JSonString + ")")
End Function
 
Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) 'As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function
 
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) 'As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function
 
Public Function GetPropertyType(ByVal JsonObject As Object, ByVal PropertyName As String) As JsonPropertyType
    On Error Resume Next
    Dim o As Object
    Set o = GetObjectProperty(JsonObject, PropertyName)
    If Err.Number Then
        GetPropertyType = jptValue
        Err.Clear
        On Error GoTo 0
    Else
        GetPropertyType = jptObject
    End If
End Function
 
Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim key As Variant
 
    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    If Length > 0 Then
        ReDim KeysArray(Length - 1)
        Index = 0
        For Each key In KeysObject
            KeysArray(Index) = key
            Index = Index + 1
        Next
        GetKeys = KeysArray
    Else
        GetKeys = KeysArray
    End If
End Function

這部份的程式碼用於處理JSON資料，而呼叫的方式如下列程式碼：

Option Explicit
 
Public Function ReadJSON()
 
    Dim root As Object
    Dim content As String
    Dim rootKeys() As String
    Dim keys() As String
    Dim i As Integer
    Dim obj As Object
    Dim prop As Variant
    
    content = FileSys.FileToString(CurrentProject.Path & "\example0.json")
    
    content = Replace(content, vbCrLf, "")
    content = Replace(content, vbTab, "")
 
    JsonParser.InitScriptEngine
 
    Set root = JsonParser.DecodeJsonString(content)
  
    rootKeys = JsonParser.GetKeys(root)
    
    For i = 0 To UBound(rootKeys)
    
        Debug.Print rootKeys(i)
        
        If JsonParser.GetPropertyType(root, rootKeys(i)) = jptValue Then
            prop = JsonParser.GetProperty(root, rootKeys(i))
            Debug.Print Nz(prop, "[null]")
        Else
            Set obj = JsonParser.GetObjectProperty(root, rootKeys(i))
            RecurseProps obj, 2
        End If
        
    Next i
 
End Function
 
 
Private Function RecurseProps(obj As Object, Optional Indent As Integer = 0) As Object
    Dim nextObject As Object
    Dim propValue As Variant
    Dim keys() As String
    Dim i As Integer
    
    keys = JsonParser.GetKeys(obj)
    
    For i = 0 To UBound(keys)
        
        If JsonParser.GetPropertyType(obj, keys(i)) = jptValue Then
            propValue = JsonParser.GetProperty(obj, keys(i))
            Debug.Print Space(Indent) & keys(i) & ": " & Nz(propValue, "[null]")
        Else
            Set nextObject = JsonParser.GetObjectProperty(obj, keys(i))
            Debug.Print Space(Indent) & keys(i)
            RecurseProps nextObject, Indent + 2
        End If
    
    Next i
    
End Function

筆者用這些程式主要是用來解析youtube-dl產生的JSON資料，透過解析，把影片的資訊記載到Access中，後續再依照情況選擇參數，最後再進行下載。

youtube-dl是個很有名的Youtube影片下載程式，有許多號稱可以下載影片的程式，其實底子都是youtube-dl程式在下載，而他們只是設計了一個介面便於下載，而筆者也用Access自己做了一個自用的管理介面。

youtube-dl可以透過--dump-single-json指令來產生JSON資料，相關的指令教學資訊，可以參考以下網站：
https://rg3.github.io/youtube-dl/index.html

而字幕的部分，可透過youtube-dl下載，但是要再透過FFmpeg軟體來轉成常用的STR、ASS等格式，關於ffmpeg可以參考以下網址：
https://www.ffmpeg.org/

最後做出的成品：

這個程式可以透過「加入 URL」來增加要下載的項目，它會依照是否包含「播放清單」來把項目加在「單影片」或者「播放清單影片」中，加入後可以依照自己的需求，調整影片格式、字幕語言與其他設定，設定好後即可進行下載。

很快的，30天鐵人賽已經完成，依照慣例，我還是把這次提到的相關程式碼與內容分享給大家，希望對有心想學習的人有幫助。

AccessVBA之iT管理實做.7z
7z解壓密碼： iT邦幫忙網址名稱